home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
QRZ! Ham Radio 8
/
QRZ Ham Radio Callsign Database - Volume 8.iso
/
mac
/
files
/
f6fbb
/
ping0723.lzh
/
PING.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-07-23
|
7KB
|
261 lines
program PING;
{ OH3NWQ turbo pascal 6.0 }
{ }
{ to study the route and forwarding times }
{ }
{ syntax: }
{ SP PING @ OH3RBR.FIN.EU }
{ @ OH3NWQ.FIN.EU }
{ This text is sent back to you }
{ }
{ or: }
{ SP PING @ OH3RBR.FIN.EU }
{ OH3NWQ.FIN.EU }
{ This text is sent back to you }
{ }
{ if the return bbs is not given in the }
{ title, this programme tries to find it }
{ from the R:9... lines. }
{ I.e. it picks the last one of them. }
uses dos;
type
pitkajono = string[80];
const
copyright = 'PING for FBB 5.14 v.1992-07-23 by OH3NWQ @ OH3RBR.FIN.EU';
var
kutsu,mista,mihin,
missa,tiedot,palautus : pitkajono;
function merkiksi(jono : string) : char;
begin
merkiksi := jono[1];
end;
function r_rivit(mista : string) : string;
var
rivi, vrivi : pitkajono;
sisaan : text;
paikka : integer;
begin
assign(sisaan,mista);
reset (sisaan);
readln(sisaan,rivi);
readln(sisaan,rivi);
repeat
begin
vrivi := rivi;
readln(sisaan,rivi);
end;
until ((copy(rivi,1,3) <> 'R:9') or (eof(sisaan)));
paikka := pos('@:',vrivi);
if paikka = 0 then halt(0);
vrivi := copy(vrivi,paikka+2,80);
vrivi := copy(vrivi,1,pos(' ',vrivi));
r_rivit := vrivi;
close(sisaan);
end;
procedure lue_parametrit(var tiedosto,hakemisto:pitkajono);
begin
tiedosto := 'MAIL.IN';
hakemisto := 'C:\FBB\';
end;
function leadingzero(sana : word) : string;
var
jono : string;
begin
str(sana:0,jono);
if length(jono) = 1 then
jono := '0' + jono;
leadingzero := jono;
end;
procedure hae_osoite(hmista : pitkajono ; var vastausos : pitkajono);
var
sisaan : text;
ekarivi, tokarivi, apu : pitkajono;
paikka, pituus, k, kir, nro, pis : integer;
merkki : char;
parsittava : boolean;
begin
apu := '';
parsittava := false;
kir := 0;
nro := 0;
pis := 0;
vastausos := 'SP ';
assign(sisaan,hmista);
reset (sisaan);
readln(sisaan,ekarivi);
readln(sisaan,tokarivi);
close (sisaan);
paikka := pos('<',ekarivi);
pituus := length(ekarivi);
for k := paikka+1 to pituus do
begin
if copy(ekarivi,k,1) > ' ' then
vastausos := vastausos+copy(ekarivi,k,1);
end;
pituus := length(tokarivi);
for k := 1 to pituus do
if copy(tokarivi,k,1) > ' ' then
apu := apu+copy(tokarivi,k,1);
while pos('@',apu)>0 do
apu := copy(apu,pos('@',apu)+1,80);
pituus := length(apu);
for k := 1 to pituus do
begin
merkki := merkiksi(copy(apu,k,1));
case merkki of '0'..'9' : inc(nro);
'A'..'Z' : inc(kir);
'a'..'z' : inc(kir);
'.' : inc(pis);
'*' : parsittava := true;
'?' : parsittava := true;
'$' : parsittava := true;
'<' : parsittava := true;
chr(1)..chr(31) : parsittava := true;
'['..'`' : parsittava := true;
'{'..chr(255) : parsittava := true;
end;
end;
if (nro = 0) then parsittava := true;
if (kir = 0) then parsittava := true;
if (parsittava = false) then
begin
if pis = 0 then
begin
if ((pituus >= 3) and ((nro = 1) or
(nro = 2)) and (kir >= 2))
then vastausos := vastausos + ' @ ' + apu;
end
else
begin
if ((pituus >= 10) and (nro >= 1) and
(kir >= 7) and (kir >= pis))
then vastausos := vastausos + ' @ ' + apu;
end;
end else
begin
vastausos := vastausos + ' @ ' + r_rivit(hmista);
end;
end;
procedure aloita_vastaus(osoite,imprtfile,polku : pitkajono);
const
days : array [0..6] of string[9] =
('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
var
ulos : text;
ho, mi, se, hund,
ye, mo, da, dow : word;
begin
if fsearch(imprtfile,polku) = '' then
begin
assign(ulos,polku+imprtfile);
rewrite(ulos);
close(ulos);
end;
assign(ulos,polku+imprtfile);
append(ulos);
writeln(ulos,osoite);
writeln(ulos,'RE: * Ping server *');
writeln(ulos);
writeln(ulos,copyright);
gettime(ho,mi,se,hund);
getdate(ye,mo,da,dow);
writeln(ulos,'Pinged at ', days[dow],', ',ye:0, '-',
leadingzero(mo), '-',leadingzero(da),' ',
leadingzero(ho),':',leadingzero(mi),':',
leadingzero(se),'.',leadingzero(hund));
writeln(ulos);
close(ulos);
end;
procedure pingaa_rivit(mikatied,imprtfile,polku : pitkajono);
var
sisaan, ulos : text;
rivi : pitkajono;
begin
assign(ulos,polku+imprtfile);
append(ulos);
assign(sisaan,mikatied);
reset (sisaan);
repeat
begin
readln (sisaan,rivi);
rivi := copy(rivi,1,73);
if not (copy(rivi,1,3)='/EX') then
writeln (ulos,'PING> ',rivi);
end;
until (eof(sisaan)) or (copy(rivi,1,3)='/EX');
writeln(ulos);
writeln(ulos,'End of PING - I''m alive.');
writeln(ulos,'/EX');
close (ulos);
close (sisaan);
end;
begin {Pääohjelma}
if paramcount < 1 then
begin
writeln(copyright);
writeln('Ping is a server for a FBB 5.14 mailbox');
halt(0);
end;
mista := paramstr(1);
lue_parametrit(mihin,missa);
hae_osoite(mista,palautus);
aloita_vastaus(palautus,mihin,missa);
pingaa_rivit(mista,mihin,missa);
end.